#!/usr/bin/perl
#
# Tool for manipulating lists of aliases in the places DB
#
# Options:
# -l [place] - list all aliases [starting with place]
# -u [file] - update from file
#   Input file format:
#   <number>|<nameid>|<within>|<comment> - verify that this still exists
#    ADD    |
#    DEL    |
# This file format is the same as produced with -l.
#
use FileTable;
use Fcntl;
use strict;
use vars qw($usage $mode $target);

$usage = "Usage: $0 [-l [area]] [-u file]\n";

while ($ARGV[0] =~ /^-/) {
    my $opt = shift;
    if ($opt eq "-l") {
	$mode = "list";
	$target = shift if $ARGV[0] !~ /^-/;
    } elsif ($opt eq "-u") {
	$mode = "update";
    } elsif ($opt eq "-c") {
	$mode = "check";
    } else {
	die $usage;
    }
}
if ($mode eq "check") {
    warn "Checking changes from file\n";
    updatealiases(0);
} elsif ($mode eq "update") {
    warn "Updating from file\n";
    updatealiases(1);
} elsif ($mode eq "list") {
    if ($target) {
        warn "Listing under $target\n";
    } else {
	warn "Listing all aliases\n";
    }
    listaliases($target);
} else {
    die $usage;
}

sub listaliases {
    my $file = FileTable::open("db/places");
    my $target = shift;
    my @entries;
    my $within;
    my $entry;
    if (defined($target)) {
	@entries = $file->select("type = 'alias' and name like '$target%'");
    } else {
	@entries = $file->select("type = 'alias'");
    }
    for $entry (@entries) {
	$within = $file->get($entry->{within});
	print $entry->key, "|", $entry->{name}, "|", 
	$within->{name}, "|", $entry->{longname}, "\n";
    }
}

sub updatealiases {
    my $doit = shift;
    my $file;
    if ($doit) {
	$file = FileTable::open("db/places", O_RDWR);
    } else {
	$file = FileTable::open("db/places");
    }	
    my $changes = 0;
    my $wasdone = 0;
    my $checks = 0;
    my $problems = 0;

    while (<>) {
	chop;
	next if /^\s*#/; # comment
	next if /^\s*$/; # empty line
	my ($act, $name, $within, $comment) = split(/\|/);
	if ($act eq "ADD") {
	    my $rec = $file->getbykey("name", $name);
	    if ($rec) {
		warn "DONE: Already exists: $$rec{type} $name\n";
		++ $wasdone;
		next;
	    }
	    my $parent = $file->getbykey("name", $within);
	    if (!$parent) {
		warn "PROBLEM: No such parent: $within\n";
		++ $problems;
		next;
	    }
	    if ($doit) {
		$rec = $file->newnum();
		$rec->{type} = "alias";
		$rec->{name} = $name;
		$rec->{within} = $parent->key;
		$rec->{longname} = $comment;
		$rec->store();
		warn "OK: Created record $name pointing to ", $parent->key, "\n";
	    } else {
		warn "OK: Would create record $name pointing to ", $parent->key, "\n";
	    }
	    ++ $changes;
	} elsif ($act eq "DEL") {
	    my $rec = $file->getbykey("name", $name);
	    if (!$rec) {
		warn "DONE: Does not exist to delete: $name\n";
		++ $wasdone;
		next;
	    }
	    if ($rec->{type} ne "alias") {
		warn "PROBLEM: Not an alias, but $$rec{type}: $name\n";
		++ $problems;
		next;
	    }
	    if ($doit) {
		$rec->delete();
		warn "OK: Deleted $name\n";
	    } else {
		warn "OK: Would have deleted $name\n";
	    }
	    ++ $changes;
	} elsif ($act eq "CHANGE") {
	    # Change from something else to alias
	    my $rec = $file->getbykey("name", $name);
	    if (!$rec) {
		warn "PROBLEM: Does not exist to change: $name\n";
		++ $problems;
		next;
	    }
	    if ($rec->{type} eq "alias") {
		warn "DONE: Already an alias: $name\n";
		++ $wasdone;
		next;
	    }
	    my $parent = $file->getbykey("name", $within);
	    if (!$parent) {
		warn "PROBLEM: No such parent: $within\n";
		++ $problems;
		next;
	    }
	    my $oldtype = $rec->{type};
	    if ($doit) {
		$rec->{within} = $parent->key;
		$rec->{longname} = $comment;
		$rec->{type} = "alias";
		$rec->store();
		warn "OK: Changed record $name from $oldtype to alias\n";
	    } else {
		warn "OK: Would change record $name from $oldtype to alias\n";
	    }
	    ++ $changes;
	} elsif ($act =~ /^\d+$/) {
	    # Verification
	    my $rec = $file->get($act);
	    if (!$rec) {
		warn "PROBLEM: No record number $act\n";
		++ $problems;
		next;
	    }
	    if ($rec->{type} ne "alias") {
		warn "PROBLEM: Not an alias, but $$rec{type}: $act\n";
		++ $problems;
		next;
	    }
	    if ($rec->{name} ne $name) {
		warn "PROBLEM: Changed name: $name to $$rec{name}\n";
		++ $problems;
		next;
	    }
	    ++ $checks;
	} else {
	    warn "PROBLEM: No such command as $act\n";
	    ++ $problems;
	}
    }
    warn "$changes changes, $wasdone already done, $problems problems, $checks checks OK\n";
}


	    
		
		
	    
